perm filename JUST.FAI[XAP,BGB] blob sn#052884 filedate 1973-07-06 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TEXT JUSTFICATION MODES:
C00003 00003	SUBR TEXT
C00008 00004	SUBR SBLINE
C00011 ENDMK
C⊗;
;TEXT JUSTFICATION MODES:
	$AUTOCR←←-1
	$CLIP←←	  0
	$BOTH←←	  1
	$RIGHT←←  2
	$CENTER←← 3
	$LEFT←←	  4
SUBR TEXT
BEGIN TEXT
	LAC 1,CHAR
	SKIPE TEXTPC
	GO @TEXTPC	;Co-routine linkage!
	GO NEWPAR
GETCHR:	POP P,TEXTPC	;Where to continue co-routine
	POP0J		;TEXT is called with a PUSHJ

;Begin a paragraph
NEWPAR:	CALL LBFLUSH	;Flush any existing text
CR1:
NXTCHR:	CALL GETCHR	;Get a character
GOTCHR:	CAR 0,A00(1)	;Special?
	JUMPN 0,SPCHAR
PUTCHR:	SKIPN TJNODE	;If not clip mode
	GO COLOK
	LAC 0,COL	;Check column overflow
	CAMGE 0,TJRMAR
	GO COLOK	;OK
	CALL LBLINE	;Put out line
	SETOM LFFLAG	;Set flag for line feed
	LAC 0,LMAR	;Reset margin and column
	DAC 0,TJLMAR
	DAC 0,COL
COLOK:	LAC 2,FONT	;Check for font change
	CAMN 2,TJFONT
	GO FONTOK
	LACI 2,177	;Save number of font
	IDBP 2,TJPTR
	SOSG TJCNT
	CALL LBLOSE
	LAC 2,FONT
	IDBP 2,TJPTR
	SOSG TJCNT
	CALL LBLOSE
	SKIPN 2,FONTAB(2)	;Make sure the font exists!
	CALL NOFONT
	LAC 0,203(2)	;Check height
	CAMLE 0,TJHEIGHT
	DAC 0,TJHEIGHT
	LAC 0,201(2)	;Check depth
	SUB 0,203(2)
	CAMLE 0,TJDEPTH
	DAC 0,TJDEPTH
FONTOK:	IDBP 1,TJPTR	;Put character into buffer
	SOSG TJCNT
	CALL LBLOSE
	PUSH P,[NXTCHR]	;Fake a return address!
ADVCOL:	LAC 2,FONT
	SKIPN 2,FONTAB(2)	;Fetch address of font
	CALL NOFONT	;Font not there!
	ADD 2,1		;Update column
	CAR 0,(2)
	ADDM 0,COL
	POP0J
;Special characters
SPCHAR:	CAIN 1," "
	GO [ CALL PUTCHR	;Put space into line buffer
	     SKIPG TJMODE	;Are we justifying?
	     GO NXTCHR		;No, just get next character
	     CALL GETCHR	;Get another character
	     CAIN 1," "		;Flush multiple spaces (is this really
	     GO $.-2		;a good idea?)
	     GO GOTCHR ]	;Put character into buffer
	CAIN 1,15		;<RETURN>?
	GO [ SKIPG TJMODE	;Are we justifying?
	     GO [ CALL TJFLUSH	;No, flush current line
		  LAC 1,LMAR	;Reset column and left margin
		  DAC 1,TJLMAR
		  DAC 1,COL
		  GO NXTCHR ]
	     CALL GETCHR	;[Justify mode] Get another character
	     CAIE 1,12
	     GO [ FATAL(Bare <RETURN> illegal in justify mode) ]
	     CALL GETCHR	;Test for start of paragraph
	     CAR 0,A00(1)	;Special?
	     GO [ PUSH P,1	;Save printing character
		  LACI 1," "	;Stuff space instead of return
		  CALL PUTCHR	;Put into buffer
		  POP P,1	;Now do printer character
		  GO PUTCHR ]
	     CAIE 1,15
	     CAIN 1,12
	     GO [ CALL TJFLUSH
		  SETOM LFFLAG
		  CALL TJFLUSH
		  GO NEWPAR ]
	     CAIE 1,11
	     CAIN 1,40
	     GO [ CALL TJFLUSH
		  SETOM LFFLAG
	     CR2: CALL @0
		  CALL GETCHR
		  CAIE 1,11
		  CAIN 1,40
		  GO CR2
		  GO GOTCHR ]
	     CAIE 1,14
	     CAIN 1,13
	     GO [ CALL TJFLUSH
		  CALL @0
		  SETOM LFFLAG
		  GO NEWPAR ]
	     CALL @0
	     GO NXTCHR
	     GO PUTCHR ]
	CAIN 1,12
	GO [ SKIPG TJMODE
	     GO [ CALL TJFLUSH
		  SETOM LFFLAG
		  GO NXTCHR ]
	     FATAL(Bare <LINE FEED> illegal in text mode) ]
	CAIE 1,13
	CAIN 1,14
	GO [ CALL TJFLUSH
	     CALL @0
	     SETOM LFFLAG
	     GO NEWPAR ]
	CALL @0
	GO NXTCHR
	GO PUTCHR

BEND TEXT
SUBR SBLINE
	PTR←←16
	MOVE←←15
	EXTRA←←14
	PUSH P,1
	PUSH P,EXTRA
	PUSH P,PTR
	PUSH P,MODE
	PUSH P,CHAR
	PUSH P,FONT
	LAC MODE,TJMODE
	LAC PTR,[POINT 7,LINBUF]
	CAMN PTR,TJPTR
	POP0J
	LAC EXTRA,TJRMAR
	SUB EXTRA,TJSPOS
	LAC 1,TJLMAR
	DAC 1,COL
	LAC 1,TJPTR
	CAILE MODE,$CLIP
	DAC 1,TJSPTR
	CAIN MODE,$CENTER
	ASH EXTRA,-1
	CAIE MODE,$RIGHT
	CAIN MODE,$CENTER
	ADDM EXTRA,COL
	SKIPN LFFLAG
	GO LOOP1
	SETZM LFFLAG
	LAC 1,TJDEPTH
	CAMGE 1,TJODEPTH
	LAC 1,TJODEPTH
	ADD 1,TJHEIGTH
	ADD 1,XLINE
	ADDM 1,ROW
	CALL ROWCHK
LOOP1:	CAMN PTR,TJPTR
	GO LINDON
	ILDB 1,PTR
	CAIN 1,177
	GO [ ILDB 1,PTR
	CAIN 1,177
	GO .+1
	DAC 1,FONT
	GO LOOP1 ]
	CAIN 1," "
	CAIE MODE,$BOTH
	GO [ DAC 1,CHAR
	CALL PRINT
	GO LOOP1]
	LAC 0,EXTRA
	IDIV 0,TJSCNT
	SOSGE TJSCNT
	GO [ FATAL(SPACE COUNT SCREWED UP) ]
	SUB EXTRA,0
	LAC 1,FONT
	SKIPN 1,FONTAB(1)
	CALL NOFONT
	CAR 1," "(1)
	ADD 1,0
	ADDM 1,COL
	GO LOOP1
LINDON:	CAMN PTR,TJPTR
	GO EMPTY
	LAC PTR,[POINT 7,LINBUF,6]
	LAC 1,FONT
	IDPB 1,PTR
	LACI 1,5*LILEN-2
	DAC 1,TJCNT
	LAC EXTRA,TJSPTR
LOOP2:	CAMN EXTRA,TJPTR
	GO MOVDON
	ILDB 1,EXTRA
	IDPB 1,PTR
	SOS TJCNT
	CAIE 1,177
	GO LOOP2
	CAMN EXTRA,TJPTR
	HALT .
	ILDB 1,EXTRA
	IDPB 1,PTR
	SOS TJCNT
	CAIN 1,177
	GO LOOP2
	DAC 1,FONT
	GO LOOP2
EMPTY:
MOVDON:	SETZM TJSPTR
	SETZM TJSCNT
	SETZM TJSPOS
	DAC PTR,TJPTR

REET:	POP P,FONT
	POP P,CHAR
	POP P,MODE
	POP P,PTR
	POP P,EXTRA
	POP P,1
	POP0J